home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / MESS.SRC < prev    next >
Text File  |  1990-11-03  |  6KB  |  399 lines
  1. ;\|
  2. ;75LET.SRC     Translated from 75LET.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;75LET    12:17:05 PM  21/ 6/90   |
  4. define(Z30|A|30||)
  5. define(YES.NO|A|1||)
  6. define(CHK_FLD|N|8||)
  7. define(NUM_N|N|2||)
  8. define(NUM|A|2||)
  9. define(DATE_A|A|8||)
  10. define(DATE_B|A|10||)
  11. define(TO_DATE|S|8||)
  12. define(WAIT|N|3||)
  13. define(MEM_AD|A|22||)
  14. define(SENT_DATE|S|8||)
  15. define(CHK_DATE|S|8||)
  16. define(PUNC2|N|2||)
  17. define(CH_NAME|A|15||)
  18. define(HIS|A|3||)
  19. define(CLIN_DAY|A|25||)
  20. define(CLIN_TIME|A|10||)
  21. define(CNTR|N|2||)
  22. define(FLAG|A|1||)
  23. define(AMOUNTX|N|4||)
  24. define(S10|A|10||)
  25. define(DATECOD|S|8||)
  26. define(CODER|A|5||)
  27. define(C30|A|30||)
  28. define(TM|A|27||4)
  29. define(A30|A|30||)
  30. define(CHOICE|N|1||)
  31. define(TDND|S|8||)
  32. define(DATERP|S|8||)
  33. define(B30|A|30||)
  34. define(S1|A|1||)
  35. define(TD|S|8||)
  36. define(A8|A|8||)
  37. define(B8|A|8||)
  38. define(YES.NO|A|1||)
  39. define(N5|N|5||)
  40. define(D1|A|1||)
  41. define(NY|A|1||)
  42. define(CODEX1|S|8||)
  43. define(CTR|N|2||)
  44. define(DATEN|N|2||)
  45. define(DATEX|d|10||)
  46. define(ARRAY1|A|30||3)
  47. define(ARRAY2|A|22||3)
  48. define(ARRAY3|A|22||3)
  49. define(ARRAY4|A|4||3)
  50. define(ARRAY5|S|8||3)
  51. define(TIT|A|4||)
  52. define(PATIENT1A|A|30||)
  53. define(PUNC1|N|2||)
  54. define(N.2.0.P|N|2||)
  55. define(P.2.0.1|N|2||)
  56. define(P.2.0.2|N|2||)
  57. define(PATIENT2|A|30||)
  58. define(P.2.0.3|N|2||)
  59. define(RECTYPE1|A|4||)
  60. define(RECTYPE2|A|4||)
  61. define(PATIENT1|A|30||)
  62. define(DOB1|D|10||)
  63. define(DOB2|D|10||)
  64. define(CTR|N|4||)
  65. define(CTR3|N|2||)
  66. define(CTR2|N|4||)
  67. define(mess|a|58||12)
  68. define(ctr4|n|1||)
  69. define(WAIT|N|3||)
  70. define(mem_date|s|8||)
  71. define(ln|n|3||)
  72. open(PATIENT||0|exit)
  73. open(recalls||0|exit)
  74. open(GPSETUP||0|)
  75. clrscr
  76. trap(j|g|recallsx)
  77. trap(S|I)
  78. trap(D|I)
  79. trap(F|I)
  80. trap(R|I)
  81. trap(B|I)
  82. trap(G|I)
  83. trap(M|I)
  84. trap(N|I)
  85. trap(q|g|exit)
  86. mount(NEW1|S||)
  87. for(CTR|1|12|1)
  88. {
  89. enter(MESS[CTR]||||n|Y|n|||n)
  90. }
  91. enter(ctr4||||n|n|n|||n)
  92. enter(mem_date||||n|n|n|||n)
  93. enter(mem_ad||||n|n|n|||n)
  94. enter(ctr2||||n|n|n|||n)
  95. pchr(P|4)
  96. trap(I|G|EXIT)
  97. mount(NEW|R|P)
  98. pset(132|18|18)
  99. pchr(P|1)
  100. for(CTR|1|CTR2|1)
  101. {
  102. WAIT = (WAIT+1)
  103. if WAIT = (195) do
  104. {
  105. pmsg(WAIT;" printed - change labels and press ret...."|10|20|Y|N|S|)
  106. WAIT = (0)
  107. }
  108. pblnk(3)
  109. pfmt(1|||N|N|)
  110. pfmt(2|||N|N|)
  111. pfmt(3|||N|N|)
  112. pfmt(4|||N|N|)
  113. pfmt(5|||N|N|)
  114. pfmt(6|||N|N|)
  115. pfmt(7|||N|N|)
  116. pfmt(8|||N|N|)
  117. pfmt(9|||N|N|)
  118. pfmt(10|||N|N|)
  119. pfmt(11|||N|N|)
  120. pfmt(12|||n|n|)
  121. pblnk(3)
  122. }
  123. RECALLSX:
  124. STARTREC:
  125. date(TD|G)
  126. LASTSEEN:
  127. pmsg("MESSAGE PRINTING IS FINISHED - DO YOU WISH TO PRINT ADDRESSES?"|1|20|N|n|S|)
  128. enter(YES.NO|"YN"|||Y|Y|n|70|21|n)
  129. if YES.NO <> ("Y") goto exit
  130. pmsg("IF YOU HAVE REVERSED CARDS - PRESS A KEY TO CONTINUE "|1|22|Y|n|S|)
  131. gosub RECLABS
  132. ADDRESS1 = (MEM_AD)
  133. find(G|ADDRESS1|EXIT|)
  134. TEST_SEEN:
  135. cod.ref = (record.number)
  136. find(m|cod.ref|next_seen|)
  137. if cod.d[ctr4] = (0) goto next_seen
  138. if cod.d[ctr4] < (mem_date) then gosub PRINT_SEEN
  139. NEXT_SEEN:
  140. find(N|PATIENT|EXIT|)
  141. pmsg(RECORD.NUMBER|1|1|N|N|S|)
  142. goto TEST_SEEN
  143. PRINT_SEEN:
  144. gosub SEXIST
  145. gosub NEWX
  146. gosub SEEN_PRINT
  147. ret
  148. SEEN_PRINT:
  149. WAIT = (WAIT+1)
  150. if WAIT = (195) do
  151. {
  152. pmsg(WAIT;" printed - change cards and press ret..."|10|20|Y|N|S|)
  153. WAIT = (0)
  154. }
  155. pblnk(6)
  156. pfmt(1|||N|N|)
  157. pblnk(2)
  158. pfmt(2|||N|N|)
  159. pblnk(2)
  160. pfmt(3|||N|N|)
  161. pblnk(4)
  162. pfmt(4|||N|N|)
  163. ret
  164. SEXIST:
  165. if SEX = ("M") then TIT = ("Mr.")
  166. if SEX = ("F") do
  167. {
  168. if MARITAL.STATUS = ("M") do
  169. {
  170. TIT = ("Mrs.")
  171. }
  172. else
  173. {
  174. TIT = ("Ms.")
  175. }
  176. }
  177. if SEX = ("") then TIT = ("Ms.")
  178. trim(TIT|T)
  179. ret
  180. NEWX:
  181. NY = (" ")
  182. PATIENT1A = (PATIENT.NAME)
  183. trim(PATIENT1A|T)
  184. PUNC1 =loc(","|PATIENT1A|1||27)
  185. N.2.0.P =siz(A|PATIENT.NAME)
  186. P.2.0.1 = (PUNC1-1)
  187. PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  188. P.2.0.2 = (PUNC1+2)
  189. P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  190. PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  191. trim(PATIENT1|T)
  192. trim(PATIENT2|T)
  193. Z30 = (TIT+PATIENT1+NY+PATIENT2)
  194. ret
  195. EXIT:
  196. run("recmenu")
  197. EXIT1:
  198. run("recmenu")
  199. PRINTSTOP:
  200. ret
  201. reclabs:
  202. trap(p|d|)
  203. pchr(p|4)
  204. mount(new4|r|p|)
  205. pset(50|18|18)
  206. ret
  207. \R NEW     
  208.    &
  209.    &
  210.    &
  211.    &
  212.    &
  213.    &
  214.    &
  215.    &
  216.    &
  217.    &
  218.    &
  219.    &
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256. \
  257. MESS[1]
  258. MESS[2]
  259. MESS[3]
  260. MESS[4]
  261. MESS[5]
  262. MESS[6]
  263. MESS[7]
  264. MESS[8]
  265. MESS[9]
  266. MESS[10]
  267. MESS[11]
  268. MESS[12]
  269. \
  270. \STNEW1    
  271.                            MESSAGE FOR RECALL CARD
  272.                            -----------------------
  273.           &
  274.           &
  275.           &
  276.           &
  277.           &
  278.           &
  279.           &
  280.           &
  281.           &
  282.           &
  283.           &
  284.           &
  285.           Which Recall:&
  286.           Up to Date  :&         From Address:&
  287.           Number of copies(message only):&
  288.           Press F2 to jump to address printing after completing Date
  289.           and recall.This is only required if printing messages and
  290.           labels on separate occasions.
  291.  
  292.  
  293.  
  294.  
  295. \
  296. MESS[1]
  297. MESS[2]
  298. MESS[3]
  299. MESS[4]
  300. MESS[5]
  301. MESS[6]
  302. MESS[7]
  303. MESS[8]
  304. MESS[9]
  305. MESS[10]
  306. MESS[11]
  307. MESS[12]
  308. CTR4
  309. MEM_DATE
  310. MEM_AD
  311. CTR2
  312. \
  313. \STLABS    
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.                      PRINTS ADDRESSES ON CARDS FOR 75 VISIT
  321.                    ┌───────────────────────────────────────┐
  322.                    │ From Address:&                        │
  323.                    │ From Dob    :&          eg 01/01/1880 │
  324.                    │ To Dob      :&          eg 01/04/1914 │
  325.                    │ Year Start  :&          eg 01/04/1990 │
  326.                    │     CONTINUE:&                        │
  327.                    └───────────────────────────────────────┘
  328.                      REQUIRES CARDS IN PRINTER REVERSE SIDE
  329.                           Esc - Exit or stop printing
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338. \
  339. MEM_AD
  340. DOB1
  341. DOB2
  342. DATEX
  343. YES.NO
  344. \
  345. \R NEW4     
  346.         &
  347.            &
  348.                &
  349. -
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394. \
  395. Z30
  396. ADDRESS1
  397. AREA
  398. \
  399.